perm filename POTCAL.SAI[LOU,BGB] blob sn#006796 filedate 1974-12-08 generic text, type T, neo UTF8
00100	BEGIN "POTCAL"
00200	REQUIRE "VECTOR.SAI[II,HE]" SOURCE_FILE;
00300	INTEGER I,J,K,BREAK,EOF;
00400	REAL S1,S2,S3,S4,R,A,B;
00410	PRELOAD_WITH -1.322907, 0.951153, 5.956624,-1.523938, 1.270145,-1.576950;
00432	REAL ARRAY CSCALE[1:6];
00454	PRELOAD_WITH  2.327725,-4.252370, 2.573889, 3.388225,-2.919922, 4.413422;
00476	REAL ARRAY OFF[1:6];
00500	INTEGER ARRAY COUNT,POINTS[1:6];
00600	INTEGER ARRAY POT[1:6,1:50];
00610	BOOLEAN DELTA;
00700	REAL ARRAY THETA[1:6,1:50];
00800	SETFORMAT(12,6);
00810	OPEN(2,"DSK",0,2,0,120,BREAK,EOF);
00820	DO BEGIN
00900	OUTSTR("FILE ?");
01000	LOOKUP(2,INCHWL,EOF);
01100	END UNTIL ¬EOF;
     

00010	OUTSTR("DELTA ?");
00020	DELTA←INCHWL="Y";
00100	FOR I←1 STEP 1 UNTIL 6 DO COUNT[I]←0;
00200	WHILE I←INTIN(2) DO BEGIN "MAIN"
00400	J←COUNT[I]←COUNT[I]+1;
00500	POT[I,J]←INTIN(2);
00600	IF I=1 THEN BEGIN
00700		FOR K←1 STEP 1 UNTIL 4 DO POINTS[K]←REALIN(2);
00800		THETA[1,J]←ATAN2(POINTS[4]-POINTS[2],POINTS[3]-POINTS[1]);
00850		IF THETA[1,J]>2.0 THEN THETA[1,J]←THETA[1,J]-360.0/RAD;
00900	END ELSE
01000	IF I=3 THEN THETA[3,J]←REALIN(2)+1.36-10.27
01100	ELSE THETA[I,J]←REALIN(2)/RAD;
01200	END "MAIN";
01250	RELEASE(2);
01300	FOR I←1 STEP 1 UNTIL 6 DO BEGIN
01310		IF DELTA THEN BEGIN A←CSCALE[I];B←OFF[I] END ELSE BEGIN
01400		S1←S2←S3←S4←0.0;
01500		FOR J←1 STEP 1 UNTIL COUNT[I] DO BEGIN
01600			S1←S1+(R←POT[I,J]/'4000);
01700			S2←S2+R↑2;
01800			S3←S3+THETA[I,J];
01900			S4←S4+THETA[I,J]*R;
02000		END;
02100		R←COUNT[I]*S2-S1↑2;
02200		A←(COUNT[I]*S4-S1*S3)/R;
02300		B←(S2*S3-S1*S4)/R;
02310		END;
02400		OUTSTR(CVS(I)&CVF(A)&CVF(B)&CRLF);
02500		FOR J←1 STEP 1 UNTIL COUNT[I] DO
02600		OUTSTR(CVOS(POT[I,J]-1000)&CVS(
02610		(IF DELTA THEN 0.0 ELSE 1000.0)+
02620		0.5+((THETA[I,J]-B)*'4000/A)-POT[I,J])&CRLF);
02700		OUTSTR(CRLF&"*");
02750		INCHWL;
02800	END;
02900	END;